Group Predictions

Row

Win percentage for the week

Season Win Percentage

Games Correct

131

Games Picked

206

Number of predictions

71

Row

This Week’s Predictions
Game Prediction Winner Correct Correct Votes Correct Percent
1 Pittsburgh Steelers New England Patriots No 1 0.0141
2 Detroit Lions Chicago Bears No 4 0.0563
3 New Orleans Saints New Orleans Saints Yes 69 0.9718
4 Houston Texans New York Jets No 7 0.0986
5 Indianapolis Colts Cincinnati Bengals No 33 0.4648
6 Cleveland Browns Cleveland Browns Yes 47 0.6620
7 Baltimore Ravens Baltimore Ravens Yes 69 0.9718
8 Atlanta Falcons Tampa Bay Buccaneers No 27 0.3803
9 San Francisco 49ers San Francisco 49ers Yes 67 0.9437
10 Minnesota Vikings Minnesota Vikings Yes 56 0.7887
11 Kansas City Chiefs Buffalo Bills No 13 0.1831
12 Denver Broncos Denver Broncos Yes 49 0.6901
13 Philadelphia Eagles Dallas Cowboys No 32 0.4507
14 Green Bay Packers New York Giants No 6 0.0845
15 Miami Dolphins Tennessee Titans No 1 0.0141

Individual Predictions

row

Individual Table

Individual Results
Week 14
Name Weekly # Correct Percent Weeks Picked Season Percent Adj Season Percent Season Trend
Week 1 Week 2 Week 3 Week 4 Week 5 Week 6 Week 7 Week 8 Week 9 Week 10 Week 11 Week 12 Week 13 Week 14
Paul Presti 9 10 12 9 8 9 5 8 NA 9 9 NA 8 10 0.6667 12 0.6023 0.5163
Brandon Parks 8 8 NA NA 9 9 5 9 9 9 8 10 10 10 0.6667 12 0.5909 0.5065
MICHAEL BRANSON 8 11 10 12 9 10 4 11 10 7 8 NA 10 9 0.6000 13 0.6263 0.5816
Ryan Cvik 11 11 9 13 6 10 8 8 6 8 10 10 8 9 0.6000 14 0.6165 0.6165
Daniel Baller 6 12 11 9 8 9 3 10 8 9 10 9 8 9 0.6000 14 0.5874 0.5874
Justin Thrift 9 8 9 8 9 7 5 11 7 6 10 NA 7 9 0.6000 13 0.5526 0.5131
DERRICK ELAM 6 9 11 10 10 7 NA 5 7 7 6 NA 7 9 0.6000 12 0.5311 0.4552
Melissa Printup 8 NA 8 7 10 7 6 NA NA 5 9 9 NA 9 0.6000 10 0.5306 0.3790
Trevor MACGAVIN 6 10 8 NA 6 7 4 NA 6 6 9 13 7 9 0.6000 12 0.5230 0.4483
George Sweet 9 11 10 12 7 10 10 NA 11 8 10 13 9 8 0.5333 13 0.6737 0.6256
Justin Crick 11 11 11 13 8 11 4 11 11 8 9 12 9 8 0.5333 14 0.6650 0.6650
James Tierney 9 10 NA 10 10 12 7 10 8 9 9 10 8 8 0.5333 13 0.6250 0.5804
Gabriel Quinones 9 11 12 12 6 9 6 11 NA 8 9 NA 9 8 0.5333 12 0.6250 0.5357
Cheryl Brown 10 12 11 9 6 9 6 10 8 9 8 12 8 8 0.5333 14 0.6117 0.6117
Keithon Corpening 8 NA NA NA NA NA NA 11 12 9 8 10 6 8 0.5333 8 0.6102 0.3487
Paul Shim 10 9 10 11 7 9 4 10 10 8 11 10 8 8 0.5333 14 0.6068 0.6068
Stephen Bush 7 10 10 9 7 10 6 12 NA 5 10 11 8 8 0.5333 13 0.5885 0.5465
Shaun Dahl 8 8 10 10 7 9 5 13 9 8 NA NA 8 8 0.5333 12 0.5852 0.5016
WAYNE SCHOFIELD 12 9 7 NA 8 NA 5 10 7 NA 10 NA 8 8 0.5333 10 0.5793 0.4138
John Plaster 8 12 8 10 NA NA 6 9 7 10 9 7 8 8 0.5333 12 0.5763 0.4940
Steven Curtis NA NA 11 7 8 10 6 7 8 7 7 11 7 8 0.5333 12 0.5575 0.4779
THOMAS MCCOY 8 10 9 7 8 9 7 11 7 7 NA 10 5 8 0.5333 13 0.5521 0.5127
Alexander Santillan 5 NA 8 9 5 11 6 11 8 9 7 9 8 8 0.5333 13 0.5474 0.5083
Robert Martin 10 9 6 NA 9 9 6 9 NA 5 9 9 6 8 0.5333 12 0.5398 0.4627
Terry Hardison 10 10 9 11 7 9 4 11 9 10 9 11 8 7 0.4667 14 0.6068 0.6068
James Small 8 8 13 9 8 10 8 10 12 6 10 9 5 7 0.4667 14 0.5971 0.5971
Ronald Schmidt 11 13 11 8 8 11 5 9 8 8 7 NA 7 7 0.4667 13 0.5947 0.5522
George Mancini 7 12 10 10 9 10 6 NA 7 9 9 11 5 7 0.4667 13 0.5895 0.5474
DAVID PLATE 8 NA 8 9 8 10 5 9 11 8 9 12 NA 7 0.4667 12 0.5876 0.5037
Kevin Green 9 12 9 9 8 9 7 NA NA 6 10 11 4 7 0.4667 12 0.5739 0.4919
Manuel Vargas 10 9 11 12 7 10 6 12 5 5 7 8 9 7 0.4667 14 0.5728 0.5728
Amy Asberry 8 9 10 9 9 8 5 10 6 9 7 10 9 7 0.4667 14 0.5631 0.5631
Kristen White 7 13 8 11 6 7 7 10 8 6 10 7 8 7 0.4667 14 0.5583 0.5583
Khalil Ibrahim 7 12 9 NA 7 10 6 10 9 5 7 11 5 7 0.4667 13 0.5526 0.5131
Antonio Mitchell 10 12 NA 11 10 10 5 12 9 NA 10 12 NA 6 0.4000 11 0.6485 0.5095
William Schouviller 10 9 11 10 8 9 NA 13 10 9 9 10 10 6 0.4000 13 0.6425 0.5966
Jason Schattel 7 10 9 11 9 10 3 13 12 9 10 12 9 6 0.4000 14 0.6311 0.6311
Ramar Williams NA 11 11 9 8 8 6 12 NA 8 NA 13 9 6 0.4000 11 0.6235 0.4899
Anthony Bloss 8 10 11 12 10 10 5 9 9 8 9 11 10 6 0.4000 14 0.6214 0.6214
Montee Brown 7 NA NA 9 9 11 6 12 11 8 10 12 8 6 0.4000 12 0.6193 0.5308
Vincent Scannelli 11 11 8 11 7 NA 5 9 12 10 10 NA 8 6 0.4000 12 0.6171 0.5289
Ryan Wiggins 8 11 11 12 7 11 5 11 10 8 10 10 7 6 0.4000 14 0.6165 0.6165
Brian Patterson 10 10 8 11 7 11 5 10 10 8 11 12 7 6 0.4000 14 0.6117 0.6117
Bradley Hobson 8 10 11 12 8 11 4 NA 8 9 9 12 NA 6 0.4000 12 0.6102 0.5230
James Blejski 8 11 10 14 NA 9 7 12 7 6 9 9 9 6 0.4000 13 0.6094 0.5659
Eric Hahn 9 13 7 9 8 10 6 9 10 6 11 12 9 6 0.4000 14 0.6068 0.6068
Cody Koerwitz 7 9 11 12 7 10 6 NA 9 9 10 10 9 6 0.4000 13 0.6053 0.5621
Karen Coleman 7 10 NA 10 8 9 4 9 13 11 9 12 8 6 0.4000 13 0.6042 0.5610
Pamela AUGUSTINE 11 13 6 9 6 9 5 10 9 NA 10 11 8 6 0.4000 13 0.5885 0.5465
Earl Dixon 9 11 8 12 5 NA 7 8 9 8 9 12 8 6 0.4000 13 0.5864 0.5445
Yiming Hu 9 10 8 12 7 9 6 9 10 8 10 NA 7 6 0.4000 13 0.5842 0.5425
Shawn Carden 9 12 6 9 8 9 5 10 9 8 9 12 7 6 0.4000 14 0.5777 0.5777
Robert Gelo 6 9 10 10 9 11 5 11 6 9 9 10 8 6 0.4000 14 0.5777 0.5777
Daniel Kuehl 6 10 8 11 7 9 7 12 7 6 10 11 8 6 0.4000 14 0.5728 0.5728
Kevin Kehoe 9 10 11 12 7 8 6 10 7 8 8 8 NA 6 0.4000 13 0.5699 0.5292
Steven Webster 8 8 6 8 9 8 6 10 10 8 10 NA 7 6 0.4000 13 0.5474 0.5083
Rafael Torres 6 8 12 11 NA NA 6 NA 9 5 10 8 5 6 0.4000 11 0.5342 0.4197
Robert Lynch 9 9 6 10 10 6 4 9 10 5 9 8 7 6 0.4000 14 0.5243 0.5243
Ryan Shipley 3 8 7 6 6 7 5 10 9 6 9 NA 5 6 0.4000 13 0.4579 0.4252
Aubrey Conn 9 12 8 11 9 9 4 11 11 8 7 12 8 5 0.3333 14 0.6019 0.6019
Patrick Tynan 8 8 10 11 7 NA 5 11 10 7 11 13 8 5 0.3333 13 0.5969 0.5543
Michael Moss 10 NA 11 13 7 9 4 10 9 8 9 10 8 5 0.3333 13 0.5947 0.5522
Walter Archambo 7 10 10 11 7 9 5 9 12 NA 8 11 9 5 0.3333 13 0.5885 0.5465
Bunnaro Sun 9 10 9 8 9 9 6 9 11 8 10 10 8 5 0.3333 14 0.5874 0.5874
Brian Hollmann 8 13 8 9 8 9 6 13 8 8 8 12 6 5 0.3333 14 0.5874 0.5874
Anthony Brinson 10 11 8 6 10 9 8 10 9 7 8 11 9 5 0.3333 14 0.5874 0.5874
Jonathon Leslein 9 9 9 9 7 11 5 9 8 10 10 NA 9 5 0.3333 13 0.5789 0.5376
Thomas Brenstuhl 10 NA 8 8 8 9 5 9 11 6 11 NA 8 5 0.3333 12 0.5632 0.4827
Gregory Flint 6 11 NA 11 8 10 NA NA 9 5 8 NA 9 5 0.3333 10 0.5578 0.3984
Cherylynn Vidal 10 9 9 12 9 7 4 6 9 7 NA 9 6 5 0.3333 13 0.5312 0.4933
PABLO BURGOSRAMOS 9 11 10 12 7 12 6 8 9 7 10 NA 8 3 0.2000 13 0.5895 0.5474
Stephen Woolwine 8 13 9 NA NA 9 NA 11 11 NA 10 12 9 NA 0.0000 9 0.6866 0.4414
Michael Edmunds 10 12 10 10 NA NA NA NA NA NA NA NA NA NA 0.0000 4 0.6774 0.1935
Kevin O'NEILL 8 11 11 13 7 NA NA 10 NA NA NA NA NA NA 0.0000 6 0.6522 0.2795
Chris Papageorge 11 11 11 10 8 9 5 11 12 8 8 NA 10 NA 0.0000 12 0.6514 0.5583
Shelly Bailey 9 10 NA 10 8 11 6 NA 13 7 9 13 NA NA 0.0000 10 0.6486 0.4633
Sarah Sweet 9 12 12 9 8 NA 6 11 11 10 8 9 6 NA 0.0000 12 0.6307 0.5406
Carlos Caceres 10 NA NA NA NA NA NA NA NA NA NA NA NA NA 0.0000 1 0.6250 0.0446
Donald Park 8 12 7 9 NA NA 6 10 11 NA 9 NA NA NA 0.0000 8 0.6050 0.3457
Matthew Schultz 8 NA 10 8 9 9 6 10 11 8 9 12 5 NA 0.0000 12 0.6000 0.5143
Daniel Major 8 13 6 7 8 11 7 11 NA NA 9 NA 7 NA 0.0000 10 0.5918 0.4227
William Sherman 8 11 10 10 6 NA 5 NA 9 NA 9 NA NA NA 0.0000 8 0.5812 0.3321
Charlene Redmer 9 9 NA 9 9 11 NA 10 8 7 8 NA 6 NA 0.0000 10 0.5811 0.4151
Daniel Halse 8 9 10 NA NA NA 7 11 NA 7 7 NA 8 NA 0.0000 8 0.5776 0.3301
Rahmatullah Sharifi 11 9 8 11 8 8 5 NA NA NA NA NA NA NA 0.0000 7 0.5769 0.2884
Jamal Willis 8 10 NA NA NA NA NA 9 NA NA NA NA NA NA 0.0000 3 0.5625 0.1205
Jason James 9 NA NA NA NA NA NA NA NA NA NA NA NA NA 0.0000 1 0.5625 0.0402
Michael Beck 9 NA NA NA NA NA NA NA NA NA NA NA NA NA 0.0000 1 0.5625 0.0402
David Spielman 8 NA 11 NA NA NA 3 NA 7 8 9 NA NA NA 0.0000 6 0.5412 0.2319
Min Choi 6 7 9 11 7 10 5 13 7 5 NA NA NA NA 0.0000 10 0.5405 0.3861
Derrick Zantt 11 6 7 NA 6 9 6 11 NA NA NA NA NA NA 0.0000 7 0.5385 0.2692
Rodney Cathcart NA NA NA NA NA NA NA NA NA NA NA NA 7 NA 0.0000 1 0.5385 0.0385
TYREE BUNDY 8 8 NA NA NA NA NA NA NA NA NA NA NA NA 0.0000 2 0.5000 0.0714
Edward Ford 6 8 NA NA NA NA NA NA NA NA NA NA NA NA 0.0000 2 0.4375 0.0625

Individual Plots

Season Leaderboard

Season Leaderboard (Season Percent)
Week 14
Season Rank Name Donuts Won Weeks Picked Season Percent Adj Season Percent Season Trend
1 Stephen Woolwine 1 9 0.6866 0.4414
2 Michael Edmunds 0 4 0.6774 0.1935
3 George Sweet 2 13 0.6737 0.6256
4 Justin Crick 0 14 0.6650 0.6650
5 Kevin O'NEILL 0 6 0.6522 0.2795
6 Chris Papageorge 1 12 0.6514 0.5583
7 Shelly Bailey 2 10 0.6486 0.4633
8 Antonio Mitchell 1 11 0.6485 0.5095
9 William Schouviller 2 13 0.6425 0.5966
10 Jason Schattel 1 14 0.6311 0.6311
11 Sarah Sweet 0 12 0.6307 0.5406
12 MICHAEL BRANSON 1 13 0.6263 0.5816
13 Carlos Caceres 0 1 0.6250 0.0446
13 Gabriel Quinones 0 12 0.6250 0.5357
13 James Tierney 2 13 0.6250 0.5804
16 Ramar Williams 1 11 0.6235 0.4899
17 Anthony Bloss 2 14 0.6214 0.6214
18 Montee Brown 0 12 0.6193 0.5308
19 Vincent Scannelli 0 12 0.6171 0.5289
20 Ryan Cvik 0 14 0.6165 0.6165
20 Ryan Wiggins 0 14 0.6165 0.6165
22 Brian Patterson 1 14 0.6117 0.6117
22 Cheryl Brown 0 14 0.6117 0.6117
24 Bradley Hobson 0 12 0.6102 0.5230
24 Keithon Corpening 0 8 0.6102 0.3487
26 James Blejski 1 13 0.6094 0.5659
27 Eric Hahn 2 14 0.6068 0.6068
27 Paul Shim 1 14 0.6068 0.6068
27 Terry Hardison 0 14 0.6068 0.6068
30 Cody Koerwitz 0 13 0.6053 0.5621
31 Donald Park 0 8 0.6050 0.3457
32 Karen Coleman 2 13 0.6042 0.5610
33 Paul Presti 1 12 0.6023 0.5163
34 Aubrey Conn 0 14 0.6019 0.6019
35 Matthew Schultz 0 12 0.6000 0.5143
36 James Small 1 14 0.5971 0.5971
37 Patrick Tynan 2 13 0.5969 0.5543
38 Michael Moss 0 13 0.5947 0.5522
38 Ronald Schmidt 1 13 0.5947 0.5522
40 Daniel Major 1 10 0.5918 0.4227
41 Brandon Parks 2 12 0.5909 0.5065
42 George Mancini 0 13 0.5895 0.5474
42 PABLO BURGOSRAMOS 1 13 0.5895 0.5474
44 Pamela AUGUSTINE 1 13 0.5885 0.5465
44 Stephen Bush 0 13 0.5885 0.5465
44 Walter Archambo 0 13 0.5885 0.5465
47 DAVID PLATE 0 12 0.5876 0.5037
48 Anthony Brinson 1 14 0.5874 0.5874
48 Brian Hollmann 2 14 0.5874 0.5874
48 Bunnaro Sun 0 14 0.5874 0.5874
48 Daniel Baller 0 14 0.5874 0.5874
52 Earl Dixon 0 13 0.5864 0.5445
53 Shaun Dahl 1 12 0.5852 0.5016
54 Yiming Hu 0 13 0.5842 0.5425
55 William Sherman 0 8 0.5812 0.3321
56 Charlene Redmer 0 10 0.5811 0.4151
57 WAYNE SCHOFIELD 1 10 0.5793 0.4138
58 Jonathon Leslein 0 13 0.5789 0.5376
59 Robert Gelo 0 14 0.5777 0.5777
59 Shawn Carden 0 14 0.5777 0.5777
61 Daniel Halse 0 8 0.5776 0.3301
62 Rahmatullah Sharifi 0 7 0.5769 0.2884
63 John Plaster 0 12 0.5763 0.4940
64 Kevin Green 0 12 0.5739 0.4919
65 Daniel Kuehl 0 14 0.5728 0.5728
65 Manuel Vargas 0 14 0.5728 0.5728
67 Kevin Kehoe 0 13 0.5699 0.5292
68 Thomas Brenstuhl 1 12 0.5632 0.4827
69 Amy Asberry 0 14 0.5631 0.5631
70 Jamal Willis 0 3 0.5625 0.1205
70 Jason James 0 1 0.5625 0.0402
70 Michael Beck 0 1 0.5625 0.0402
73 Kristen White 1 14 0.5583 0.5583
74 Gregory Flint 0 10 0.5578 0.3984
75 Steven Curtis 0 12 0.5575 0.4779
76 Justin Thrift 0 13 0.5526 0.5131
76 Khalil Ibrahim 0 13 0.5526 0.5131
78 THOMAS MCCOY 0 13 0.5521 0.5127
79 Alexander Santillan 0 13 0.5474 0.5083
79 Steven Webster 0 13 0.5474 0.5083
81 David Spielman 0 6 0.5412 0.2319
82 Min Choi 1 10 0.5405 0.3861
83 Robert Martin 0 12 0.5398 0.4627
84 Derrick Zantt 0 7 0.5385 0.2692
84 Rodney Cathcart 0 1 0.5385 0.0385
86 Rafael Torres 0 11 0.5342 0.4197
87 Cherylynn Vidal 0 13 0.5312 0.4933
88 DERRICK ELAM 1 12 0.5311 0.4552
89 Melissa Printup 1 10 0.5306 0.3790
90 Robert Lynch 1 14 0.5243 0.5243
91 Trevor MACGAVIN 1 12 0.5230 0.4483
92 TYREE BUNDY 0 2 0.5000 0.0714
93 Ryan Shipley 0 13 0.4579 0.4252
94 Edward Ford 0 2 0.4375 0.0625

Adjusted Season Leaderboard

Season Leaderboard (Adjusted Season Percent)
Week 14
Season Rank Name Donuts Won Weeks Picked Season Percent Adj Season Percent Season Trend
1 Justin Crick 0 14 0.6650 0.6650
2 Jason Schattel 1 14 0.6311 0.6311
3 George Sweet 2 13 0.6737 0.6256
4 Anthony Bloss 2 14 0.6214 0.6214
5 Ryan Cvik 0 14 0.6165 0.6165
5 Ryan Wiggins 0 14 0.6165 0.6165
7 Brian Patterson 1 14 0.6117 0.6117
7 Cheryl Brown 0 14 0.6117 0.6117
9 Eric Hahn 2 14 0.6068 0.6068
9 Paul Shim 1 14 0.6068 0.6068
9 Terry Hardison 0 14 0.6068 0.6068
12 Aubrey Conn 0 14 0.6019 0.6019
13 James Small 1 14 0.5971 0.5971
14 William Schouviller 2 13 0.6425 0.5966
15 Anthony Brinson 1 14 0.5874 0.5874
15 Brian Hollmann 2 14 0.5874 0.5874
15 Bunnaro Sun 0 14 0.5874 0.5874
15 Daniel Baller 0 14 0.5874 0.5874
19 MICHAEL BRANSON 1 13 0.6263 0.5816
20 James Tierney 2 13 0.6250 0.5804
21 Robert Gelo 0 14 0.5777 0.5777
21 Shawn Carden 0 14 0.5777 0.5777
23 Daniel Kuehl 0 14 0.5728 0.5728
23 Manuel Vargas 0 14 0.5728 0.5728
25 James Blejski 1 13 0.6094 0.5659
26 Amy Asberry 0 14 0.5631 0.5631
27 Cody Koerwitz 0 13 0.6053 0.5621
28 Karen Coleman 2 13 0.6042 0.5610
29 Chris Papageorge 1 12 0.6514 0.5583
29 Kristen White 1 14 0.5583 0.5583
31 Patrick Tynan 2 13 0.5969 0.5543
32 Michael Moss 0 13 0.5947 0.5522
32 Ronald Schmidt 1 13 0.5947 0.5522
34 George Mancini 0 13 0.5895 0.5474
34 PABLO BURGOSRAMOS 1 13 0.5895 0.5474
36 Pamela AUGUSTINE 1 13 0.5885 0.5465
36 Stephen Bush 0 13 0.5885 0.5465
36 Walter Archambo 0 13 0.5885 0.5465
39 Earl Dixon 0 13 0.5864 0.5445
40 Yiming Hu 0 13 0.5842 0.5425
41 Sarah Sweet 0 12 0.6307 0.5406
42 Jonathon Leslein 0 13 0.5789 0.5376
43 Gabriel Quinones 0 12 0.6250 0.5357
44 Montee Brown 0 12 0.6193 0.5308
45 Kevin Kehoe 0 13 0.5699 0.5292
46 Vincent Scannelli 0 12 0.6171 0.5289
47 Robert Lynch 1 14 0.5243 0.5243
48 Bradley Hobson 0 12 0.6102 0.5230
49 Paul Presti 1 12 0.6023 0.5163
50 Matthew Schultz 0 12 0.6000 0.5143
51 Justin Thrift 0 13 0.5526 0.5131
51 Khalil Ibrahim 0 13 0.5526 0.5131
53 THOMAS MCCOY 0 13 0.5521 0.5127
54 Antonio Mitchell 1 11 0.6485 0.5095
55 Alexander Santillan 0 13 0.5474 0.5083
55 Steven Webster 0 13 0.5474 0.5083
57 Brandon Parks 2 12 0.5909 0.5065
58 DAVID PLATE 0 12 0.5876 0.5037
59 Shaun Dahl 1 12 0.5852 0.5016
60 John Plaster 0 12 0.5763 0.4940
61 Cherylynn Vidal 0 13 0.5312 0.4933
62 Kevin Green 0 12 0.5739 0.4919
63 Ramar Williams 1 11 0.6235 0.4899
64 Thomas Brenstuhl 1 12 0.5632 0.4827
65 Steven Curtis 0 12 0.5575 0.4779
66 Shelly Bailey 2 10 0.6486 0.4633
67 Robert Martin 0 12 0.5398 0.4627
68 DERRICK ELAM 1 12 0.5311 0.4552
69 Trevor MACGAVIN 1 12 0.5230 0.4483
70 Stephen Woolwine 1 9 0.6866 0.4414
71 Ryan Shipley 0 13 0.4579 0.4252
72 Daniel Major 1 10 0.5918 0.4227
73 Rafael Torres 0 11 0.5342 0.4197
74 Charlene Redmer 0 10 0.5811 0.4151
75 WAYNE SCHOFIELD 1 10 0.5793 0.4138
76 Gregory Flint 0 10 0.5578 0.3984
77 Min Choi 1 10 0.5405 0.3861
78 Melissa Printup 1 10 0.5306 0.3790
79 Keithon Corpening 0 8 0.6102 0.3487
80 Donald Park 0 8 0.6050 0.3457
81 William Sherman 0 8 0.5812 0.3321
82 Daniel Halse 0 8 0.5776 0.3301
83 Rahmatullah Sharifi 0 7 0.5769 0.2884
84 Kevin O'NEILL 0 6 0.6522 0.2795
85 Derrick Zantt 0 7 0.5385 0.2692
86 David Spielman 0 6 0.5412 0.2319
87 Michael Edmunds 0 4 0.6774 0.1935
88 Jamal Willis 0 3 0.5625 0.1205
89 TYREE BUNDY 0 2 0.5000 0.0714
90 Edward Ford 0 2 0.4375 0.0625
91 Carlos Caceres 0 1 0.6250 0.0446
92 Jason James 0 1 0.5625 0.0402
92 Michael Beck 0 1 0.5625 0.0402
94 Rodney Cathcart 0 1 0.5385 0.0385

Data

---
title: "2023 NFL Moneyline Picks"
output: 
  flexdashboard::flex_dashboard:
    theme:
      version: 4
      bootswatch: spacelab
    orientation: rows
    vertical_layout: fill
    social: ["menu"]
    source_code: embed
    navbar:
      - { title: "Created by: Daniel Baller", icon: "fa-github", href: "https://github.com/danielpballer"  }
---


```{r setup, include=FALSE}
#    source_code: embed
library(flexdashboard)
library(tidyverse)
library(data.table)
library(formattable)
library(ggpubr)
library(ggrepel)
library(gt)
library(glue)
library(ggthemes)
library(hrbrthemes)
library(sparkline)
library(plotly)
library(htmlwidgets)
library(mdthemes)
library(ggtext)
library(ggnewscale)
library(DT)
source("./Functions/functions2.R")

thematic::thematic_rmd(font = "auto")

```

```{r Reading in our picks files, include=FALSE}
current_week = 14 #Set what week it is
week_1 = read_csv("./CSV_Data_Files/2023 NFL Week 1.csv")
week_2 = read_csv("./CSV_Data_Files/2023 NFL Week 2.csv")
week_3 = read_csv("./CSV_Data_Files/2023 NFL Week 3.csv")
week_4 = read_csv("./CSV_Data_Files/2023 NFL Week 4.csv")
week_5 = read_csv("./CSV_Data_Files/2023 NFL Week 5.csv")
week_6 = read_csv("./CSV_Data_Files/2023 NFL Week 6.csv")
week_7 = read_csv("./CSV_Data_Files/2023 NFL Week 7.csv")
week_8 = read_csv("./CSV_Data_Files/2023 NFL Week 8.csv")
week_9 = read_csv("./CSV_Data_Files/2023 NFL Week 9.csv")
week_10 = read_csv("./CSV_Data_Files/2023 NFL Week 10.csv")
week_11 = read_csv("./CSV_Data_Files/2023 NFL Week 11.csv")
week_12 = read_csv("./CSV_Data_Files/2023 NFL Week 12.csv")
week_13 = read_csv("./CSV_Data_Files/2023 NFL Week 13.csv")
week_14 = read_csv("./CSV_Data_Files/2023 NFL Week 14.csv")
# week_15 = read_csv("./CSV_Data_Files/2023 NFL Week 15.csv")
# week_16 = read_csv("./CSV_Data_Files/2023 NFL Week 16.csv")
# week_17 = read_csv("./CSV_Data_Files/2023 NFL Week 17.csv")
# week_18 = read_csv("./CSV_Data_Files/2023 NFL Week 18.csv")
# week_19 = read_csv("./CSV_Data_Files/2023 NFL Wild Card.csv")
# week_20 = read_csv("./CSV_Data_Files/2023 NFL Divisional Round.csv")
# week_21 = read_csv("./CSV_Data_Files/2023 NFL Conference Round.csv")
# week_22 = read_csv("./CSV_Data_Files/2023 NFL Super Bowl.csv")

#reading in scores
Scores = read_csv(glue::glue("./CSV_Data_Files/NFL_Scores_{current_week}.csv")) 

#reading in CBS Prediction Records
cbs = read_csv(glue::glue("./CSV_Data_Files/CBS_Experts_{current_week}.csv")) %>% 
  mutate(Percent = round(Percent,4))
cbs_season = read_csv(glue::glue("./CSV_Data_Files/CBS_Experts_Season_{current_week}.csv"))

#reading in ESPN Prediction Records
espn = read_csv(glue::glue("./CSV_Data_Files/ESPN_Experts_{current_week}.csv"))%>% 
  mutate(Percent = round(Percent,4))
espn_season = read_csv(glue::glue("./CSV_Data_Files/ESPN_Experts_Season_{current_week}.csv"))%>% 
  mutate(Percent = round(Percent,4))

#Odds not working for the 2023 season.  Need to fix scrape code for next year.
#Reading in the moneyline odds for each team and cleaning the team names
# odds_wk1 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_1.csv"))
# odds_wk2 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_2.csv"))
# odds_wk3 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_3.csv"))
# odds_wk4 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_4.csv"))
# odds_wk5 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_5.csv"))
# odds_wk6 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_6.csv"))
# odds_wk7 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_7.csv"))
# odds_wk8 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_8.csv"))
# odds_wk9 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_9.csv"))
# odds_wk10 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_10.csv"))
# odds_wk11 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_11.csv"))
# odds_wk12 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_12.csv"))
# odds_wk13 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_13.csv"))
# odds_wk14 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_14.csv"))
# odds_wk15 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_15.csv"))
# odds_wk16 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_16.csv"))
# odds_wk17 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_17.csv"))
# odds_wk18 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_18.csv"))
# odds_wk19 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_19.csv"))
# odds_wk20 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_20.csv"))
# odds_wk21 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_21.csv"))
# odds_wk22 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_22.csv"))

####################UPDATE THESE###############################
inst.picks = list(week_1, week_2, week_3, week_4, week_5, week_6, week_7, week_8, week_9, week_10, week_11, week_12, week_13, week_14) #, week_15, week_16, week_17, week_18, week_19, week_20, week_21) #add in the additional weeks
# odds = rbind(odds_wk1, odds_wk2, odds_wk3, odds_wk4, odds_wk5, odds_wk6, odds_wk7, odds_wk8,
#              odds_wk9, odds_wk10, odds_wk11, odds_wk12) #add in the additional weeks
####################END OF UPDATE##############################

weeks = as.list(seq(1:current_week)) #creating a list of each week number
```

```{r read in scores clean data, include=FALSE}
#Cleaning Odds Data
# cl_odds = odds_cleaning(odds)

#Cleaning scores data
Scores = cleaning2(Scores)

#creating a list of winners for each week
winners = map(weeks, weekly_winners)

#creating a vector of this weeks winners
this_week = pull(winners[[length(winners)]])  

#Getting the number of games for each week
weekly_number_of_games = map_dbl(weeks, week_number_games)
```

```{r Group Predictions, include=FALSE}
#Creating the list of everyones predictions each week.
games = map(inst.picks, games_fn)

#Creating the prediction table.  
pred_table = map(games, pred_table_fn)

#Adding who won to the predictions
with_winners = map2(pred_table, winners, adding_winners)

#Creating results for each week.
results = map2(with_winners,weekly_number_of_games, results_fn)
```


```{r Displaying Group Results, echo=FALSE}
#Displaying the group results

inst_group_table = results[[length(results)]] %>% gt() %>% 
  cols_align(
    align = "center") %>% 
   tab_header(
    title = md("This Week's Predictions"),
    #subtitle = md(glue("Week {length(results)}"))
    ) %>% 
   tab_style(
    style = cell_text(color = "red", weight = "bold"),
    locations = cells_body(
      columns = c(Correct),
      rows = Correct =="No"
    )) %>% 
   tab_style(
    style = cell_text(color = "green", weight = "bold"),
    locations = cells_body(
      columns = c(Correct),
      rows = Correct =="Yes"
    )) %>% 
  tab_options(
    data_row.padding = px(3),
    container.height = "100%"
   )
```

```{r Weekly and season Group Results, include=FALSE}
# Printing the weekly and season win percentage     

#how many games correct, incorrect, and not picked each week
weekly_group_correct = map(results, weekly_group_correct_fn)  

#how many games were picked each week
weekly_games_picked = map2(weekly_group_correct, weekly_number_of_games, weekly_games_picked_fn)

#Calculating the number of correct picks for each week
weekly_group_correct_picks = map(weekly_group_correct, weekly_group_correct_picks_fn)

#Calculating weekly win percentage
weekly_win_percentage = map2(weekly_group_correct_picks, weekly_games_picked, weekly_win_percentage_fn)

#Calculating season win percentage
season_win_percentage = round(sum(unlist(weekly_group_correct_picks))/sum(unlist(weekly_games_picked)),4)

#Calculating number of games picked this season
season_games = sum(unlist(weekly_games_picked))

#calculating season wins
season_wins = sum(unlist(weekly_group_correct_picks))

#calculating the number of people who picked this week
Total = dim(inst.picks[[length(weeks)]])[1]
```

```{r plotting group results, include=FALSE}
#Previous Weeks
group_season_for_plotting = unlist(weekly_win_percentage) %>% as.data.frame() %>% 
  rename(`Win Percentage` = ".") %>% 
  add_column(Week = unlist(weeks))
```

```{r Plotting the group results, echo=FALSE}
inst_group_season_plot = group_season_for_plotting %>% 
ggplot(aes(x = as.factor(Week), y = `Win Percentage`))+
  geom_point()+
  geom_path(aes(x = Week))+
  ylim(c(0, 1)) +
  xlab("NFL Week") + 
  ylab("Correct Percentage")+
  ggtitle("Weekly Group Correct Percentage")+
  theme_classic()+
  theme(plot.title = element_text(hjust = 0.5, size = 18))
```

```{r beating cbs week, include=FALSE}
#Creating a list of correct percentages for each week.
cbs_weekly_percent = map(weeks, cbs_percent)

#Creating a list of how many cbs experts we beat each week.
cbs_experts_beat = map2(cbs_weekly_percent, weekly_win_percentage, experts_beat)

#Creating a list of how many cbs experts picked each week.  
cbs_experts_total = map(cbs_weekly_percent, experts_tot)
```

```{r beating cbs season, include=FALSE}
#Creating a list of correct percentages for each week.
cbs_season_percent = map(weeks, cbs_season_percent)

#Creating a list of how many cbs experts we beat each week.
cbs_experts_beat_season = map2(cbs_season_percent, season_win_percentage, experts_beat)

#Creating a list of how many cbs experts picked each week.  
cbs_experts_season_total = map(cbs_season_percent, experts_tot)
```

```{r beating ESPN week, include=FALSE}
#Creating a list of correct percentages for each week.
espn_weekly_percent = map(weeks, espn_percent)

#Creating a list of how many cbs experts we beat each week.
espn_experts_beat = map2(espn_weekly_percent, weekly_win_percentage, experts_beat)

#Creating a list of how many cbs experts picked each week.  
espn_experts_total = map(espn_weekly_percent, experts_tot)
```

```{r beating ESPN season, include=FALSE}
#Creating a list of correct percentages for each week.
espn_season_percent = map(weeks, espn_season_percent)

#Creating a list of how many cbs experts we beat each week.
espn_experts_beat_season = map2(espn_season_percent, season_win_percentage, experts_beat)

#Creating a list of how many cbs experts picked each week.  
espn_experts_season_total = map(espn_season_percent, experts_tot)
```

```{r individual results, include=FALSE}
#Creating a list of individual results for each week.
weekly_indiv = pmap(list(inst.picks, winners, weeks), indiv_weekly_pred)

#Combining each week into one dataframe and calculating percentage Correct for this week.  
full_season = weekly_indiv %>% reduce(full_join, by = "Name") %>% 
  mutate(Percent = round(pull(.[,ncol(.)]/weekly_number_of_games[[length(weekly_number_of_games)]]),4)) 

#Creating a dataframe with only the weekly picks
a = full_season %>% select(starts_with("Week"))

#Creating a vector of how many weeks each person picked over the season
tot_week = NULL
help = NULL
for (i in 1:dim(a)[1]){
  for(j in 1:length(a)){
    help[j] = ifelse(is.na(a[i,j])==T,0,1)
    tot_week[i] = sum(help)
  }
}

#Creating a vector of how many games each person picked over the season
tot_picks= NULL
help = NULL
for (i in 1:dim(a)[1]){
  for(j in 1:length(a)){
    help[j] = unlist(weekly_games_picked)[j]*ifelse(is.na(a[i,j])==T,0,1)
    tot_picks[i] = sum(help)
  }
}

#Creatign a vector of how many games each person picked correct over the season
tot_correct = NULL
help = NULL
for (i in 1:dim(a)[1]){
  tot_correct[i] = sum(a[i,], na.rm = T)
}

#adding how many weeks each person picked, season correct percentage, and adjusted season percentag to the data frame and sorting the data
indiv_disp = full_season %>% add_column(`Weeks Picked` = tot_week) %>%
  add_column(tot_correct)%>%
  add_column(tot_picks)%>%
  mutate(`Season Percent` = round(tot_correct/tot_picks,4))%>%
  mutate(`Adj Season Percent` = round(`Season Percent`*(tot_week/length(a)),4)) %>%
  select(-tot_correct, -tot_picks) %>%
  arrange(desc(Percent), desc(`Season Percent`)) %>%
  mutate(Percent = ifelse(is.na(Percent)==T, 0, Percent))
```


```{r individual percentages, include=FALSE}
#Calculating individual percentages for each week.
weekly_indiv_percent = map2(weekly_indiv, as.list(weekly_number_of_games), indiv_percent) %>% reduce(full_join, by = "Name")

weekly_indiv_percent_plot = weekly_indiv_percent %>% 
  pivot_longer(cols = starts_with("Week"), names_to = "Week", values_to = "Percent")%>%
  mutate(Percent = ifelse(is.na(Percent)==T, 0, Percent)) %>% 
  mutate(Week = as.factor(Week))

levels = NULL
for(i in 1:length(weeks)){
  levels[i] = glue("Week {i}")  
}

weekly_indiv_percent_plot = weekly_indiv_percent_plot %>%
  mutate(Week = factor(Week, levels))
```

```{r sparklines, include=FALSE}
#adding sparklines
plot_group = function(name, df){
  plot_object = 
    ggplot(data = df,
           aes(x = as.factor(Week), y=Percent, group = 1))+
    geom_path(size = 7)+
    scale_y_continuous(limits = c(0,1))+
    theme_void()+
    theme(legend.position = "none")
  return(plot_object)
}

sparklines = 
  weekly_indiv_percent_plot %>% 
  group_by(Name) %>% 
  nest() %>% 
  mutate(plot = map2(Name, data, plot_group)) %>% 
  select(-data)
  
indiv_disp_2 = indiv_disp %>% 
  inner_join(sparklines, by = "Name") %>% 
  mutate(`Season Trend` = NA)
```

```{r Printing Individual Table2, echo=FALSE}
# Printing the individual Table
indiv_table = indiv_disp_2 %>% gt() %>% 
  cols_align(
    align = "center") %>% 
   tab_header(
    title = md("Individual Results"),
    subtitle = md(glue("Week {length(weeks)}"))
    ) %>% 
   tab_style(
    style = cell_text(color = "red", weight = "bold"),
    locations = cells_body(
      columns = c(Percent),
      rows = Percent<.5
    )) %>% 
   tab_style(
    style = cell_text(color = "green", weight = "bold"),
    locations = cells_body(
      columns = c(Percent),
      rows = Percent>.5
    )) %>% 
     tab_style(
    style = cell_text(color = "red", weight = "bold"),
    locations = cells_body(
      columns = c(`Season Percent`),
      rows = `Season Percent`<.5
    )) %>% 
   tab_style(
    style = cell_text(color = "green", weight = "bold"),
    locations = cells_body(
      columns = c(`Season Percent`),
      rows = `Season Percent`>.5
    ))%>% 
     tab_style(
    style = cell_text(color = "red", weight = "bold"),
    locations = cells_body(
      columns = c(`Adj Season Percent`),
      rows = `Adj Season Percent`<.5
    )) %>% 
   tab_style(
    style = cell_text(color = "green", weight = "bold"),
    locations = cells_body(
      columns = c(`Adj Season Percent`),
      rows = `Adj Season Percent`>.5
    )) %>% 
  tab_options(
    container.width = pct(100),
    data_row.padding = px(1),
    container.height = "100%"
   ) %>%
    tab_spanner(
    label = "Weekly # Correct",
    columns = starts_with(c("Week "))
  ) %>% 
  text_transform(
    locations = cells_body(c(`Season Trend`)),
    fn = function(x){
      map(indiv_disp_2$plot, ggplot_image, height = px(30), aspect_ratio = 4)
                 }) %>%
  cols_hide(c(plot))

indiv_winners = indiv_disp_2 %>% filter(Percent == max(Percent)) %>% select(Name) %>% pull() %>% paste(collapse = ", ")
indiv_season = indiv_disp_2 %>% filter(`Season Percent` == max(`Season Percent`)) %>% select(Name) %>% pull() %>% paste(collapse = ", ")
indiv_season_adj = indiv_disp_2 %>% filter(`Adj Season Percent` == max(`Adj Season Percent`)) %>% select(Name) %>% pull()%>% paste(collapse = ", ")
```

```{r Printing Season Leaderboard, echo=FALSE}
# Printing the Season Leaderboard
  
season_leaderboard = indiv_disp_2 %>% select(Name, starts_with("Week ")) %>% 
  pivot_longer(starts_with("Week"),names_to = "Week", values_to = "Correct") %>% 
  group_by(Week) %>% 
  mutate(Correct = case_when(is.na(Correct)==T~0, 
                             TRUE~Correct)) %>% 
  mutate(Donut = case_when(Correct==max(Correct)~1,
                           TRUE~0))  %>% 
  ungroup() %>% 
  group_by(Name) %>% 
  summarise(`Donuts Won` = sum(Donut)) %>% 
  #mutate(`Donuts Won` = strrep("award,", Donuts)) %>% 
  right_join(.,indiv_disp_2) %>% 
  select(-starts_with("Week "), -Percent) %>% 
  mutate(`Season Rank` = min_rank(desc(`Season Percent`)),.before = Name) %>% 
  arrange(`Season Rank`) %>% 
  gt() %>% 
  cols_align(
    align = "center") %>% 
   tab_header(
    title = md("Season Leaderboard (Season Percent)"),
    subtitle = md(glue("Week {length(weeks)}"))
    ) %>% 
  # fmt_icon(
  #   columns = `Donuts Won`,
  #   fill_color = "gold",
  # ) %>%
  tab_style(
    style = cell_text(color = "red", weight = "bold"),
    locations = cells_body(
      columns = c(`Season Percent`),
      rows = `Season Percent`<.5
    )) %>% 
   tab_style(
    style = cell_text(color = "green", weight = "bold"),
    locations = cells_body(
      columns = c(`Season Percent`),
      rows = `Season Percent`>.5
    ))%>% 
     tab_style(
    style = cell_text(color = "red", weight = "bold"),
    locations = cells_body(
      columns = c(`Adj Season Percent`),
      rows = `Adj Season Percent`<.5
    )) %>% 
   tab_style(
    style = cell_text(color = "green", weight = "bold"),
    locations = cells_body(
      columns = c(`Adj Season Percent`),
      rows = `Adj Season Percent`>.5
    )) %>% 
  tab_options(
    container.width = pct(100),
    data_row.padding = px(1),
    container.height = "100%"
   ) %>%
    tab_spanner(
    label = "Weekly # Correct",
    columns = starts_with(c("Week "))
  ) %>% 
  text_transform(
    locations = cells_body(c(`Season Trend`)),
    fn = function(x){
      map(indiv_disp_2$plot, ggplot_image, height = px(30), aspect_ratio = 4)
                 }) %>%
  cols_hide(columns = c(plot))
```

```{r Printing Adj Season Leaderboard, echo=FALSE}
# Printing the Adj Season Leaderboard
  
adj_season_leaderboard = indiv_disp_2 %>% select(Name, starts_with("Week ")) %>% 
  pivot_longer(starts_with("Week"),names_to = "Week", values_to = "Correct") %>% 
  group_by(Week) %>% 
  mutate(Correct = case_when(is.na(Correct)==T~0, 
                             TRUE~Correct)) %>% 
  mutate(Donut = case_when(Correct==max(Correct)~1,
                           TRUE~0))  %>% 
  ungroup() %>% 
  group_by(Name) %>% 
  summarise(`Donuts Won` = sum(Donut)) %>% 
  #mutate(`Donuts Won` = strrep("award,", Donuts)) %>% 
  right_join(.,indiv_disp_2) %>% 
  select(-starts_with("Week "), -Percent) %>% 
  mutate(`Season Rank` = min_rank(desc(`Adj Season Percent`)),.before = Name) %>% 
  arrange(`Season Rank`) %>% 
  gt() %>% 
  cols_align(
    align = "center") %>% 
   tab_header(
    title = md("Season Leaderboard (Adjusted Season Percent)"),
    subtitle = md(glue("Week {length(weeks)}"))
    ) %>% 
  # fmt_icon(
  #   columns = `Donuts Won`,
  #   fill_color = "gold",
  # ) %>%
  tab_style(
    style = cell_text(color = "red", weight = "bold"),
    locations = cells_body(
      columns = c(`Season Percent`),
      rows = `Season Percent`<.5
    )) %>% 
   tab_style(
    style = cell_text(color = "green", weight = "bold"),
    locations = cells_body(
      columns = c(`Season Percent`),
      rows = `Season Percent`>.5
    ))%>% 
     tab_style(
    style = cell_text(color = "red", weight = "bold"),
    locations = cells_body(
      columns = c(`Adj Season Percent`),
      rows = `Adj Season Percent`<.5
    )) %>% 
   tab_style(
    style = cell_text(color = "green", weight = "bold"),
    locations = cells_body(
      columns = c(`Adj Season Percent`),
      rows = `Adj Season Percent`>.5
    )) %>% 
  tab_options(
    container.width = pct(100),
    data_row.padding = px(1),
    container.height = "100%"
   ) %>%
    tab_spanner(
    label = "Weekly # Correct",
    columns = starts_with(c("Week "))
  ) %>% 
  text_transform(
    locations = cells_body(c(`Season Trend`)),
    fn = function(x){
      map(indiv_disp_2$plot, ggplot_image, height = px(30), aspect_ratio = 4)
                 }) %>%
  cols_hide(columns = c(plot))

```


```{r instructor formattable, echo=FALSE}
improvement_formatter <- 
  formatter("span", 
            style = x ~ formattable::style(
              font.weight = "bold", 
              color = ifelse(x > .5, "green", ifelse(x < .5, "red", "black"))),
             x ~ icontext(ifelse(x == max(x), "star", ""), x))

indiv_disp_3 = indiv_disp_2 %>% select(-plot)
indiv_disp_3$`Season Trend` = apply(indiv_disp_3[,2:(1+length(weeks))], 1, FUN = function(x) as.character(htmltools::as.tags(sparkline(as.numeric(x), type = "line", chartRangeMin = 0, chartRangeMax = 1, fillColor = "white"))))

indiv_table_2 = as.htmlwidget(formattable(indiv_disp_3, 
                                align = c("l", rep("c", NROW(indiv_disp_3)-1)),
              list(`Season Percent` = color_bar("#FA614B"),
              `Season Percent`= improvement_formatter,
              `Adj Season Percent`= improvement_formatter)))
              
indiv_table_2$dependencies = c(indiv_table_2$dependencies, htmlwidgets:::widget_dependencies("sparkline", "sparkline"))
```

```{r Plotting individual results over the season2, echo=FALSE, out.width = "100%"}
#Creating the individual plot.  
inst_indiv_plots = weekly_indiv_percent_plot %>% 
  ggplot(aes(x = factor(Week), y = Percent, color = Name))+
  geom_point()+
  geom_path(aes(x = as.factor(Week), y = Percent, color = Name, 
                group = Name))+
  ylim(c(0, 1)) +
  labs(x = "NFL Week", 
       y = "Correct Percentage", 
       title = "Weekly Individual Correct Percentage")+
  facet_wrap(~Name)+
  theme_classic()+
  theme(legend.position = "none",
        plot.title = element_text(hjust = 0.5, size = 18),
        axis.text.x=element_text(angle =45, vjust = 1, hjust = 1))
```

```{r data for data page}
inst.data = map2(inst.picks, weeks, disp_data) %>% bind_rows()
```


```{r fivethirtyeight}
inst_538 = map(results, five38) %>% unlist() %>% sum()
```

```{r pregame, eval=FALSE, include=FALSE}
#Predictions for the week

#Creating the list of group predictions each week.
games = map(inst.picks, games_fn)

#Creating the prediction table.  
pred_table = map(games, pred_table_fn)

#Printing table of instructor predictions
pred_table[[length(pred_table)]] %>% mutate(Game = row_number()) %>% 
  rename(`Votes For` = votes_for, `Votes Against` = votes_against) %>% 
  gt() %>% 
  cols_align(
    align = "center") %>% 
   tab_header(
    title = md("This Week's Predictions"),
    subtitle = md(glue("Week {length(weeks)}"))
    ) %>% 
   tab_options(
    data_row.padding = px(3)
   )
```

Group Predictions
==========================================================================

Sidebar {.sidebar} 
-------------------------------------
#### CBS Sports

<font size="4">

This week we beat or tied `r cbs_experts_beat[[length(weeks)]]` of `r cbs_experts_total[[length(weeks)]]` CBS Sports' Experts.

For the season we are currently beating or tied with `r cbs_experts_beat_season[[length(weeks)]]` of `r cbs_experts_season_total[[length(weeks)]]` CBS Sports' Experts.
 
 </font>


#### ESPN

<font size="4">

We also beat or tied `r espn_experts_beat[[length(weeks)]]` of `r espn_experts_total[[length(weeks)]]` ESPN Experts.
 
For the season we are currently beating or tied with `r espn_experts_beat_season[[length(weeks)]]` of `r espn_experts_season_total[[length(weeks)]]` ESPN Experts.

</font>

Row
--------------------------------------

### Win percentage for the week

```{r}
inst_rate <- weekly_win_percentage[[length(weekly_win_percentage)]]*100
gauge(inst_rate, min = 0, max = 100, symbol = '%', gaugeSectors(
  success = c(55, 100), warning = c(40, 54), danger = c(0, 39)
))
```

### Season Win Percentage

```{r}
inst_season <- season_win_percentage*100
gauge(inst_season, min = 0, max = 100, symbol = '%', gaugeSectors(
  success = c(55, 100), warning = c(40, 54), danger = c(0, 39)
))
```

### Games Correct
```{r}
valueBox(value = season_wins,icon = "fa-trophy",caption = "Correct Games this Season")
```

### Games Picked
```{r}
valueBox(value = season_games,icon = "fa-clipboard-list",caption = "Games Picked this Season")
```

### Number of predictions
```{r}
valueBox(value = Total,icon = "fa-users",caption = "Predictions this week")
```

Row
--------------------------------------

### 

```{r}
inst_group_table
```

### 

```{r}
ggplotly(inst_group_season_plot) %>% 
  layout(title = list(y = .93, xref = "plot"),
         margin = list(t = 40))
```

Individual Predictions
==========================================================================


Sidebar {.sidebar} 
-------------------------------------

#### Best Picks of the Week.

<font size="4">

 `r indiv_winners`
 
 </font>
 
#### Best Season Correct Percentage
<font size="4">

`r indiv_season`
 
 </font>

#### Best Adjusted Season Correct Percentage
<font size="4">

`r indiv_season_adj`

 * Adjusted season percentage accounts for the number of weeks picked.
 
 </font>

row {.tabset}
--------------------------------------

### Individual Table
```{r}
indiv_table
```

<!--
### Individual Table2

```{r, out.height="100%"}
indiv_table_2
```

-->

### Individual Plots
```{r, out.width="100%"}
ggplotly(inst_indiv_plots)
```

### Season Leaderboard
```{r, out.width="100%"}
season_leaderboard
```

### Adjusted Season Leaderboard
```{r, out.width="100%"}
adj_season_leaderboard
```

Data
==========================================================================

```{r}
datatable(
  inst.data, extensions = 'Buttons', options = list(
    dom = 'Blfrtip',
    buttons = c('copy', 'csv', 'excel', 'pdf', 'print'),
    lengthMenue = list( c(10, 25, 50, 100, -1), c(10, 25, 50, 100, "All") )
  )
)
```